home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / info-service / gopher / Rice_CMS / gopher24 / gopcliui.$rexx < prev    next >
Encoding:
Text File  |  1993-01-25  |  12.3 KB  |  157 lines
  1. /*                                                                      00010000
  2.  *        Name: GOPCLIUI REXX                                           00020000
  3.  *              VM TCP/IP Network GOPHER Client user input              00030000
  4.  *      Author: Rick Troth, Rice University, Information Systems        00040000
  5.  *        Date: 1992-Dec-23                                             00050000
  6.  *                                                                      00060000
  7.  *       Input: a prompt string                                         00070000
  8.  *      Output: the user's response                                     00080000
  9.  *                                                                      00090000
  10.  *              Untested with multiples,  but should work that way.     00100000
  11.  */                                                                     00110000
  12.                                                                         00120000
  13. /*                                                                      00130000
  14.  *      Copyright 1992 Richard M. Troth.   This software was developed  00140000
  15.  *      with resources provided by Rice University and is intended      00150000
  16.  *      to serve Rice's user community.   Rice has benefitted greatly   00160000
  17.  *      from the free distribution of software,  therefore distribution 00170000
  18.  *      of unmodified copies of this material is not restricted.        00180000
  19.  *      You may change your own copy as needed.   Neither Rice          00190000
  20.  *      University nor any of its employees or students shall be held   00200000
  21.  *      liable for damages resulting from the use of this software.     00210000
  22.  */                                                                     00220000
  23.                                                                         00230000
  24. Trace "OFF"                                                             00240000
  25.                                                                         00250000
  26. /*  fetch fs. stem variable from calling REXX environment  */           00260000
  27. 'CALLPIPE REXXVARS 1 | DROP | JOIN 1 /,/' ,                             00270000
  28.         '| CHANGE /n /,/ | CHANGE /,v /,/ 1 | LOCATE /FS./ | VARLOAD'   00280000
  29.                                                                         00290000
  30. /*  trouble with plain write,  so fetch current screen contents  */     00300000
  31. 'CALLPIPE LITERAL 00 | SPEC 1-2 X2C 1' ,                                00310000
  32.         '| FULLSCR' fs.tube 'CONDREAD | VAR SCREEN'                     00320000
  33. Parse Var screen 1 aid 2 cursor 4 screen                                00330000
  34.                                                                         00340000
  35. Do Forever                                                              00350000
  36.                                                                         00360000
  37.     'PEEKTO PROMPT'                                                     00370000
  38.     If rc ^= 0 Then Leave                                               00380000
  39.                                                                         00390000
  40.     Parse Var prompt prompt ';' preset                                  00400000
  41.     prompt = Strip(prompt)                                              00410000
  42.     preset = Strip(preset)                                              00420000
  43.                                                                         00430000
  44.     /* --------------------------------------------------------- GPROMPT00440000
  45.      *  Present a prompt and read from the Gopher user's screen.        00450000
  46.      *  Preset response data may have been supplied.                    00460000
  47.      */                                                                 00470000
  48.                                                                         00480000
  49.     prompt = fs.write || 'C3'x || screen || ,                           00490000
  50.             sba(1,-1) || field("PROT","GREEN") || prompt ,              00500000
  51.             || field("HIGH","WHITE") || '13'x || preset || ,            00510000
  52.             Copies('00'x,fs.scrcols*2-Length(prompt)-Length(preset)-4) ,00520000
  53.             || field("PROT")                                            00530000
  54.                                                                         00540000
  55.     'CALLPIPE VAR PROMPT | FULLSCR' fs.tube '| VAR RS'                  00550000
  56.     Parse Var rs With 1 aid 2 . 4 rs                                    00560000
  57.                                                                         00570000
  58.     If  aid = '7D'x   /* enter */   Then Do                             00580000
  59.         Parse Var rs With . '11'x rs                                    00590000
  60.         rs = Substr(rs,3)                                               00600000
  61.         If rs = "" Then rs = preset                                     00610000
  62.         'OUTPUT' rs                                                     00620000
  63.         End  /*  If  ..  Do  */                                         00630000
  64.                                                                         00640000
  65.     Else 'OUTPUT'                                                       00650000
  66.                                                                         00660000
  67.     'CALLPIPE VAR CURSOR | SPEC /00C311/ X2C 1 1.2 NEXT' ,              00670000
  68.             '/13/ X2C NEXT | FULLSCR' fs.tube 'NOREAD | HOLE'           00680000
  69.                                                                         00690000
  70.     'READTO'                                                            00700000
  71.                                                                         00710000
  72.     End  /*  Do  Forever  */                                            00720000
  73.                                                                         00730000
  74. Exit rc * (rc ^= 12)                                                    00740000
  75.                                                                         00750000
  76.                                                                         00760000
  77.                                                                         00770000
  78.                                                                         00780000
  79. /* ----------------------------------------------------------------- SBA00790000
  80.  * (a better SBA function extracted from PIPEDEMO; thanks, Chuck!)      00800000
  81.  * Construct Set Buffer Address order from row and column.              00810000
  82.  */                                                                     00820000
  83.                                                                         00830000
  84. SBA:      Procedure Expose fs.                                          00840000
  85.                                                                         00850000
  86. arg row , col, .                                                        00860000
  87. row = Trunc(row)                                                        00870000
  88. col = Trunc(col)                                                        00880000
  89.                                                                         00890000
  90. /*-----------------------------------------------------------------*/   00900000
  91. /* Calculate binary address.                                       */   00910000
  92. /*-----------------------------------------------------------------*/   00920000
  93.                                                                         00930000
  94. offset = row * fs.scrcols + col                                         00940000
  95. Do While offset < 0; offset = offset + fs.scrrows * fs.scrcols; End     00950000
  96.                                                                         00960000
  97. if fs.14bit then return '11'x || d2c(offset,2)                          00970000
  98.                                                                         00980000
  99. /*-----------------------------------------------------------------*/   00990000
  100. /* Convert to six-bit format. (xxxx111111111111 -> 0011111100111111*/   01000000
  101. /*-----------------------------------------------------------------*/   01010000
  102.                                                                         01020000
  103. 'CALLPIPE var offset'               ,   /* Start with char number.    */01030000
  104.     '| spec 1-* d2c 1.2 right'      ,   /* Convert to binary.         */01040000
  105.     '| spec 1-* c2b 1'              ,   /* Convert to bit string.     */01050000
  106.     '| spec /00/ 1  5.6  3'         ,   /* Place first six bits.      */01060000
  107.            '/00/ 9 11.6 11'         ,   /* Place second six bits.     */01070000
  108.     '| spec 1-* b2c 1'              ,   /* Convert back to binary.    */01080000
  109.     '| xlate *-* 00-3F 40-7F'       ,   /* Translate to coded         */01090000
  110.                 '01-09 C1-C9'       ,   /*   buffer address.          */01100000
  111.                 '11-19 D1-D9'       ,   /*                            */01110000
  112.                 '22-29 E2-E9'       ,   /*                            */01120000
  113.                 '30-39 F0-F9'       ,   /*                            */01130000
  114.     '| spec x11 1 1.2 2'            ,   /* Prefix with SBA order.     */01140000
  115.     '| var offset'                      /* Put back in variable.      */01150000
  116.                                                                         01160000
  117. Return offset                                                           01170000
  118.                                                                         01180000
  119.                                                                         01190000
  120.                                                                         01200000
  121. /* --------------------------------------------------------------- FIELD01210000
  122.  * Generate the 3270 DS sequence for extended field attributes          01220000
  123.  * (if available).                                                      01230000
  124.  */                                                                     01240000
  125. FIELD:    Procedure Expose fs.                                          01250000
  126. a = '00'x                                                               01260000
  127. b = '00'x                                                               01270000
  128. c = 'F1'x                                                               01280000
  129. i = 1                                                                   01290000
  130. Do While Arg(i) ^= ""                                                   01300000
  131.     Select  /*  at  */                                                  01310000
  132.         When Abbrev("PROTECTED",Arg(i),2)   Then a = bitor(a,'20'x)     01320000
  133.         When Abbrev("SKIP",Arg(i),1)        Then a = bitor(a,'10'x)     01330000
  134.         When Abbrev("NODISPLAY",Arg(i),1)   Then a = bitor(a,'0C'x)     01340000
  135.         When Abbrev("HIGH",Arg(i),1)        Then a = bitor(a,'08'x)     01350000
  136.         When Abbrev("BLINK",Arg(i),3)       Then b = bitor(b,'01'x)     01360000
  137.         When Abbrev("REVERSE",Arg(i),3)     Then b = bitor(b,'02'x)     01370000
  138.         When Abbrev("UNDERLINE",Arg(i),1)   Then b = bitor(b,'04'x)     01380000
  139.         When Abbrev("BLUE",Arg(i),3)        Then c = 'F1'x              01390000
  140.         When Abbrev("RED",Arg(i),3)         Then c = 'F2'x              01400000
  141.         When Abbrev("PINK",Arg(i),1)        Then c = 'F3'x              01410000
  142.         When Abbrev("GREEN",Arg(i),1)       Then c = 'F4'x              01420000
  143.         When Abbrev("TURQUOISE",Arg(i),1)   Then c = 'F5'x              01430000
  144.         When Abbrev("YELLOW",Arg(i),1)      Then c = 'F6'x              01440000
  145.         When Abbrev("WHITE",Arg(i),1)       Then c = 'F7'x              01450000
  146.         Otherwise nop                                                   01460000
  147.         End  /*  Select  at  */                                         01470000
  148.     i = i + 1                                                           01480000
  149.     End  /*  Do  While  */                                              01490000
  150.                                                                         01500000
  151. If  ^fs.color   | ,                                                     01510000
  152.     ^fs.exthi   Then    Return '1D'x || bitor(a,'40'x)                  01520000
  153.                 Else    Return '2902'x || ,                             01530000
  154.                                'C0'x   || bitor(a,'40'x) || ,           01540000
  155.                                '42'x   || bitor(c,'40'x)                01550000
  156.                                                                         01560000
  157.